数据地图系列10|excel（VBA）数据地图透明度填充法

今天要跟大家分享数据地图系列的第10篇——excel（VBA）数据地图透明度填充法。

这种方法的制作步骤难度与前一篇相比都较低，但是涉及到的VBA代码却要比前一篇略复杂一点。

1、首先我们要准备的是世界地图素材：

本案例中数据多达191个国家，每个国家图形名称都取得是“S_”+“前三个字母大写”，需要一一命名，当然这个过程是非常耗时费力的，推送后我会将本例源文件贡献，如感兴趣，可以直接拿案例中已经命名好的矢量图形尝试着去做。

2、添加透明度列变量

=($E$1-D4)/($E$1-$E$2)*90%

根据指标值的范围将指标值转化为0%~90%的透明度指标。

3、选择透明度填充的主色，作为填充色色调的主题色。

将选好的主色填充到指定单元格中。（H3）

4、插入一个矩形（命名为color_label）将作为地图图例

5、输入VBA填色代码

ALT+F11打开VBA编辑器，输入以下代码：

 Sub fill_color_vba()

    Application.CalculateFull  '模拟效果用

    On Error Resume Next '个别国家无图形，忽略

    Application.ScreenUpdating = False '暂停刷新屏幕

    For i = 4 To 193  '为数据源的起始和结束行号

        ActiveSheet.Shapes(Range("sheet1!C" & i).Value).Fill.ForeColor.RGB = Range("SHEET1!H3").Interior.Color

        '使用选定的颜色填充图形

        ActiveSheet.Shapes(Range("sheet1!C" & i).Value).Fill.Transparency = Range("SHEET1!E" & i).Value

        '按匹配的透明度值设置图形的透明度

    Next i

    ActiveSheet.Shapes("color_label").Fill.ForeColor.RGB = Range("SHEET1!H3").Interior.Color

        '设置图例的填充色

    ActiveSheet.Shapes("color_label").Fill.TwoColorGradient msoGradientVertical, 2

    'ActiveSheet.Shapes("color_label").Fill.OneColorGradient msoGradientVertical, 2, 0.23

        '设置图例的渐变效果

    Application.ScreenUpdating = True '恢复刷新屏幕

End Sub

6、在开发工具中插入一个按钮，并的制定宏代码（命名为填色）。

然后点击一下填色按钮，看下神奇的效果吧~

最后将插入的矩形（作为地图图例）放在数据地图的合适位置，使用照相机快照功能将整个数据地图牌照引用。

保存的时候仍然要保存为xlsm格式的带宏文件。

只需要将你提前准备好的填充颜色主色复制进填色单元格中，然后单击填色按钮，就可以实现不同色调的填充效果。